(* ===================================================================== *)
(** Optimisation du cds final avant construction du circuit.
    On enleve les portes Id, Gnd, Vdd, on fait de l'evaluation partielle
    On detecte statiquement les simpilfications dues aux entrees invariantes
    sur les portes logiques.
    @author Mathieu Barbin
    @version mercredi 31 décembre 2008, 15:42:34 (UTC+0100) *)
(* ===================================================================== *)


(*
#load "unix.cma";;
#load "graphics.cma";;
#load "bplib.cma";;
#load "bebop.cma";;
*)

open BplibTypes
open Bplib
open Message 
open ListMap
open Inputtools
open Circuit

(*
let array_exists fct a =
  let len = Array.length a in
  let rec aux i = 
    if i >= len then false
    else if fct a.(i) then true else aux (succ i)
  in aux 0;;
*)

let f_xor a b = if a then not(b) else b;;

(* on ecrit ici l'optimisateur de cds *)
(*

  Buts : 
  - enlever les portes : id, gnd, vdd
  - faire de l'evaluation partielle sur les signaux invariants


  ADD : il faudrait aussi ajouter une notion d'unused :
  supprimer un noeud s'il n'a pas de voisins.
  (avec des messages de warning pour les pipes et external
  et une option -ru remove unused qui les enleve dans tous les cas)
  (sauf les ram qui font des effets de bords ... (reg ?) )

*)


(* Pour toute entree : soit elle est invariante, soit elle est pointee par un parent *)

(* 
   Pour pouvoir faire le chemin dans le sens inverse entre les 2 parties des registres 
   Regr ---> Regt : deja pointée
   Regt ---> Regr : impossible en theorie : d'ou l'ajout d'un tag pour les Regt
   qui va prendre la valeur du Regr qui pointe implicitement sur lui
*)

type entree_taguee = Invariante | DontCare | Pointee of (int*  int);;
type noeud_tague =  
    {
      mutable delete : bool;
      mutable used : bool;
      infos_node : noeud;
      mutable entrees_taguee : entree_taguee array;
    }

let noeud_tague_of_noeud n =
  {
    delete = false;
    used = false;
    infos_node = n;
    entrees_taguee = Array.make (Array.length n.entree) Invariante;
  }
    
(* On va proceder a 2 parcours avec point fixe apres reinspection *)
(* La complexite n'est pas amelioree a faire les 2 parcours en une fois,
   et compiquerai la lisibilité *) 

(* 
   Dans cette premiere analyse, on fait du calcul sur l'invariance.
   Les seuls noeuds qui peuvent faire ajouter la reinspection sont l'analyse des 
   registres. Dans les autres cas, le premier tour est suffisant.
   
   On profite de ce parcours pour marquer comme utiles les noeuds suivants :

   output         : normal, c'est la sortie du circuit
   pipe, external : en general, les tests unitaires et les messages sont du debugg, 
   ils n'ont pas de sortie, mais ils sont interressants car produisent des effets de bords

   Ram & Reg : si on ne lit jamais sa sortie, les effets de bords qu'on realise sont inutiles.

   Les autres noeuds sont purement combinatoire : par d'effet de bord.
 *)
  
let remove_invariance_of_cds ?(verbose=false) cds =
  (* Lors d'un premier parcours, on releve dans une file les noeuds a reinspecter *)
  (* Apres, on reitere sur la file jusqu'a ce qu'elle soit vide *)
  (* Pour eviter de remplir la file avec les memes personnes, on consulte un planning *)

  let used_nodes = Queue.create () in
  let get_used_nodes () = used_nodes in
  let to_reinspecte = Queue.create () in
  let len = Array.length cds in  
  let planning_inspection = Array.make len true in (* Au debut, tout le monde est prevu au planning *)
  let reinspecte_node i = 
    (* Tout depend du planning *)
    if planning_inspection.(i) 
    then () (* On a deja prevu d'inspecter ce noeud, inutile de le mettre en file *)
    else  
      begin (* Ok, dans ce cas, on l'ajoute au planning *)
	planning_inspection.(i) <- true;
	Queue.add i to_reinspecte
      end 
  in
  let cds_tag = Array.map noeud_tague_of_noeud cds in 
  let use_node i = Queue.add i used_nodes in
  let finish () = cds_tag 
  in
  (* Apres s'etre rendu compte qu'une entree est invariante, on la tague comme ca 
     et on met la valeur constante dans les entrees directement *)
  let assign_invariant value (v, index) =
    begin 
      cds_tag.(v).infos_node.entree.(index) <- value;
      cds_tag.(v).entrees_taguee.(index) <- Invariante;
      (* Du coup, il faut reinspecter ce noeud *)
      reinspecte_node v
    end
  in
  let assign_dontcare (v, index) =
    begin
      cds_tag.(v).entrees_taguee.(index) <- DontCare;
      (* Du coup, il faut reinspecter ce noeud *)
      reinspecte_node v
    end
  in
  (* Si une entree n'est pas invariante, alors elle est pointee par un parent *)
  let assign_pointee (v, index) (a, b) = cds_tag.(a).entrees_taguee.(b) <- Pointee (v, index) in
  (* Les differentes fonctions de traitement d'un noeud i *)
  let remove_as_cst_value ?pointage ~value i =
    begin
      (* Dans le cas d'application partielle, 
	 on enleve une porte comme si c'etait un gnd mais elle possede un parent sur une de ses entrees *)
      (
	match pointage with
	| None -> ()
	| Some (v, index) -> 
	    let filter (a, b) = (a <> i)  in
	    let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
	    cds_tag.(v).infos_node.voisins.(index) <- removed_this
      );
      (* Tous les voisins d'une porte Gnd sont invariant a false *)
      (* Une fois cette assignassion faite, la porte peut etre supprimee *)
      List.iter (assign_invariant value) cds_tag.(i).infos_node.voisins.(0);
      cds_tag.(i).delete <- true 
    end
  in
  let remove_as_dontcare ?pointage i =
    begin
      (* Dans le cas d'application partielle, 
	 on enleve cette porte mais elle possede un parent sur une de ses entrees *)
      (
	match pointage with
	| None -> ()
	| Some (v, index) -> 
	    let filter (a, b) = (a <> i)  in
	    let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
	    cds_tag.(v).infos_node.voisins.(index) <- removed_this
      );
      (* Tous les voisins de la porte doivent etre mis a DontCare *)
      (* Une fois cette assignassion faite, la porte peut etre supprimee *)
      Array.iter (fun voisins -> List.iter assign_dontcare voisins) cds_tag.(i).infos_node.voisins;
      cds_tag.(i).delete <- true  
    end
  in
  let remove_reg_as_cst_value ~regt ?pointage ~value i =
    begin
      (* il faut transformer le Regt en cst value *) 
      remove_as_cst_value ~value:value regt;
      (* il faut enlever le pointage vers Regr *)
      (
	match pointage with
	| None -> ()
	| Some (v, index) ->
	    let filter (a, b) = (a <> i)  in
	    let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
	    cds_tag.(v).infos_node.voisins.(index) <- removed_this
      );
      (* Et on peut enfin enlever ce noeud aussi *)
      cds_tag.(i).delete <- true 
    end
  and remove_as_id (v, index) i = 
    begin
      (* il faut enlever le pointeur vers ici dans (v, index) et y ajouter ses propres voisins *)
      (* par conditions de contexte, les listes sont disjointes *)
      let filter (a, b) = (a <> i) in
      let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
      cds_tag.(v).infos_node.voisins.(index) <- removed_this@cds_tag.(i).infos_node.voisins.(0);
      (* Propager l'information Pointee sur les nouveaux voisins *)
      List.iter (assign_pointee (v, index)) cds_tag.(i).infos_node.voisins.(0);
      cds_tag.(i).delete <- true
    end    
  (* Dans certains cas, il faut modifier les pointeurs de v car on change l'index d'entree *)
  and changing_into_not (v, index) ?(old_index_input=0) i =
    begin
      (
	if old_index_input <> 0 
	then
	  begin
	    let f_map (a, b) = if a = i then (a, 0) else (a, b) in
	    cds_tag.(v).infos_node.voisins.(index) <- List.map f_map cds_tag.(v).infos_node.voisins.(index);
	  end
	else ()
      );
      let new_porte_not =
	{
	  delete = false;
	  used = false;
	  entrees_taguee = [|Pointee (v, index)|];
	  infos_node =
	    {
	      entree = [|cds_tag.(i).infos_node.entree.(old_index_input)|];
	      sortie = cds_tag.(i).infos_node.sortie;
	      voisins = cds_tag.(i).infos_node.voisins;
	      noeud_type = Not
	    }
	}
      in
      cds_tag.(i) <- new_porte_not ;
      (* Il faut le revisiter maintenant, ainsi que son pere qui peut etre un Not *)
      reinspecte_node v;
      reinspecte_node i
    end
  and garder_noeud i = 
    (* Dans le cas ou on garde le noeud, il faut propager les infos de pointage sur les voisins *)
    Array.iteri (fun j voisins -> List.iter (assign_pointee (i, j)) voisins) cds_tag.(i).infos_node.voisins 
  in 
  (* La fonction d'inspection qui decide du caractere inutile d'un noeud *) 
  let inspection i =

(*    prerr_endline (Printf.sprintf "Invariance node %d" i); *)

    planning_inspection.(i) <- false; (* maintenant, on peut etre amene a reinspecter celui la *)
    if cds_tag.(i).delete then ()  
    else 
      begin
	(* Les cas qui nous interresse : Gnd, Vdd, Id *)
	match cds_tag.(i).infos_node.noeud_type with
	| Opt -> remove_as_dontcare i
	| Gnd -> remove_as_cst_value ~value:false i
	| Vdd | Clock -> remove_as_cst_value ~value:true i 
	| Id ->
	    begin
	      match cds_tag.(i).entrees_taguee.(0) with
	      | DontCare -> remove_as_dontcare i
	      | Invariante -> 
		  begin
		    (* issu d'une opt ci-dessus par exemple *)
		    (* On propage l'invariance, ensuite la porte Id peut etre supprimee *)
		    let value = cds_tag.(i).infos_node.entree.(0) in
		    remove_as_cst_value ~value:value i
		  end
	      | Pointee (v, index) -> remove_as_id (v, index) i
	    end 
	      
	(* Pour Ram et Rom on va produire un Warning parce que ca ne devrait pas arriver 
	   le programmeur va modifier son code en consequence. Une ram ou rom avec un bit d'entree
	   invariant est un malaise de design *)
	      
	| Rom (name, _) | Ram (name, _) ->
	    begin
	      let invariantes = ref [] in
	      let iter j t = if t = Invariante || t = DontCare then invariantes := j::(!invariantes) else () in
	      for j = pred (Array.length cds_tag.(i).entrees_taguee) downto 0 do
		iter j cds_tag.(i).entrees_taguee.(j)
	      done;
	      (
		if !invariantes <> [] 
		then Message.message#entree_invariante_memory name (string_of_list string_of_int ", " "(" ")" !invariantes)
		else ()
	      );
	      garder_noeud i
	    end
	      
	(* Attention, dans le cas d'application partielle, on va supprimer la porte donc il 
	   ne faut pas oublier d'enlever les liens des parents *) 
	      
	| Not ->
	    begin
	      (* Il n'y a pas d'application partielle comme il n'y a qu'une entree *)
	      (* En revanche, on applique la simplification des Not(Not(Not(...) 
		 Pour cela, on observe si la cible du Not est aussi un Not, 
		 dans ce cas on remplace les 2 portes par un simple Id *)
	      match cds_tag.(i).entrees_taguee.(0) with
	      | Pointee (v, index) -> 
		  begin
		    (* On change toutes les portes fils Not de la porte i en un id du parent de i *)
		    let fold_fils_i accu (j, other_index) = 
		      match cds_tag.(j).infos_node.noeud_type with
		      | Not -> remove_as_id (v, index) j; accu (* Il faut garder le pere index *)
		      | _ -> (j, other_index)::accu
		    in
		    let new_fils = List.fold_left fold_fils_i [] cds_tag.(i).infos_node.voisins.(0) in
		    (* Il faut penser a enlever les liens vers les fils Not 
		       de sorte que s'il n'y a plus d'autre but, le noeud sera enleve
		       lors de l'analyse de necessite *)
		    cds_tag.(i).infos_node.voisins.(0) <- new_fils;
		    garder_noeud i 
		  end
	      | Invariante ->
		  (* optimisation : propagation du not de cette invariance *)
		  let value = not cds_tag.(i).infos_node.entree.(0) in
		  remove_as_cst_value ~value:value i
	      | DontCare -> remove_as_dontcare i (* Le resultat est donc aussi un DontCare *)
	    end
	      
	| Et -> 
	    begin
	      (* Il peut y avoir application partielle a gauche ou a droite *)
	      match cds_tag.(i).entrees_taguee.(0), cds_tag.(i).entrees_taguee.(1) with
	      | Pointee _, Pointee _ -> (* pas d'optimisation *) garder_noeud i
	      | Pointee (v, index), Invariante -> 
		  begin
		    (* si l'entree 1 est a false, c'est une porte Gnd, sinon, c'est une Id(0) *)
		    if cds_tag.(i).infos_node.entree.(1) 
		    then remove_as_id (v, index) i
		    else remove_as_cst_value ~pointage:(v, index) ~value:false i
		  end
	      | Invariante, Pointee (v, index) -> 
		  begin
		    (* si l'entree 0 est a false, c'est une porte Gnd, sinon, c'est une Id(1) *)
		    if cds_tag.(i).infos_node.entree.(0) 
		    then remove_as_id (v, index) i
		    else remove_as_cst_value ~pointage:(v, index) ~value:false i
		  end
	      | Invariante, Invariante ->
		  (* Invariance totale : calcul statique *)
		  begin
		    let value = cds_tag.(i).infos_node.entree.(0) && cds_tag.(i).infos_node.entree.(1) in
		    remove_as_cst_value ~value:value i
		  end
	      | DontCare, DontCare -> remove_as_dontcare i
	      | Pointee (v, index), DontCare | DontCare, Pointee (v, index) ->
		  (* Dans ce cas la, le DontCare est assigne a false, et la porte devient un Gnd *)
		  begin
		    remove_as_cst_value ~pointage:(v, index) ~value:false i
		  end 
	      | Invariante, DontCare ->
		  begin
		    (* si l'entree 0 est a true, DontCare, sinon c'est une porte Gnd *)
		    if cds_tag.(i).infos_node.entree.(0) 
		    then remove_as_dontcare i
		    else remove_as_cst_value ~value:false i
		  end
	      | DontCare, Invariante ->
		  begin
		    if cds_tag.(i).infos_node.entree.(1) 
		    then remove_as_dontcare i
		    else remove_as_cst_value ~value:false i
		  end
	    end
	| Ou ->
	    begin
	      (* Il peut y avoir application partielle a gauche ou a droite *)
	      match cds_tag.(i).entrees_taguee.(0), cds_tag.(i).entrees_taguee.(1) with
	      | Pointee _, Pointee _ -> (* pas d'optimisation *) garder_noeud i
	      | Pointee (v, index), Invariante -> 
		  begin
		    (* si l'entree 1 est a true, c'est une porte Vdd, sinon c'est une porte Id(0) *)
		    if cds_tag.(i).infos_node.entree.(1) 
		    then remove_as_cst_value ~pointage:(v, index) ~value:true i
		    else remove_as_id (v, index) i
		  end
	      | Invariante, Pointee (v, index) -> 
		  begin
		    (* si l'entree 0 est a true, c'est une porte Vdd, sinon c'est une porte Id(1) *)
		    if cds_tag.(i).infos_node.entree.(0) 
		    then remove_as_cst_value ~pointage:(v, index) ~value:true i
		    else remove_as_id (v, index) i
		  end
	      | Invariante, Invariante ->
		  (* Invariance totale : calcul statique *)
		  begin
		    let value = cds_tag.(i).infos_node.entree.(0) || cds_tag.(i).infos_node.entree.(1) in
		    remove_as_cst_value ~value:value i
		  end
	      | DontCare, DontCare -> remove_as_dontcare i
	      | Pointee (v, index), DontCare | DontCare, Pointee (v, index) -> 
		  remove_as_cst_value ~pointage:(v, index) ~value:true i
		    (* Dans le cas ci-dessus, le DontCare est assigne a true, et la porte devient Vdd *)
	      | Invariante, DontCare ->
		  begin
		    if cds_tag.(i).infos_node.entree.(0)
		    then remove_as_cst_value ~value:true i (* La porte renvoit tjs 1 *)
		    else remove_as_dontcare i (* sinon, on en fait ce qu'on veut *)
		  end
	      | DontCare, Invariante ->
		  begin
		    if cds_tag.(i).infos_node.entree.(1)
		    then remove_as_cst_value ~value:true i (* La porte renvoit tjs 1 *)
		    else remove_as_dontcare i (* sinon, on en fait ce qu'on veut *)
		  end
	    end
	| Xor -> 
	    begin
	      (* Il peut y avoir application partielle a gauche ou a droite *)
	      match cds_tag.(i).entrees_taguee.(0), cds_tag.(i).entrees_taguee.(1) with
	      | Pointee _, Pointee _ -> (* pas d'optimisation *) garder_noeud i
	      | Pointee (v, index), Invariante -> 
		  begin
		    (* si l'entree 1 est a true, c'est une porte not(0), sinon c'est une porte Id(0) *)
		    if cds_tag.(i).infos_node.entree.(1) 
		    then changing_into_not (v, index) i
		    else remove_as_id (v, index) i
		  end
	      | Invariante, Pointee (v, index) -> 
		  begin
		    (* si l'entree 0 est a true, c'est une porte not(1), sinon c'est une porte Id(1) *)
		    if cds_tag.(i).infos_node.entree.(0) 
		    then changing_into_not ~old_index_input:1 (v, index) i (* Car anciennement pointe sur 1 et pas 0 *)
		    else remove_as_id (v, index) i
		  end
	      | Invariante, Invariante ->
		  (* Invariance totale : calcul statique *)
		  begin
		    let value = f_xor cds_tag.(i).infos_node.entree.(0) cds_tag.(i).infos_node.entree.(1) in
		    remove_as_cst_value ~value:value i
		  end
		    
	      (* Avec le xor, il suffit d'un unique DontCare pour devenir DontCare. xor(a, opt()) = Gnd si opt = a Vdd si opt = not(a)  *) 
	      | Pointee (v, index), DontCare | DontCare, Pointee (v, index) -> remove_as_dontcare ~pointage:(v, index) i 
	      | _ -> remove_as_dontcare i
	    end
	      
	| Mux ->
	    begin
	      (* Les applications partielles qui vont nous interresser : 
		 - invariance du bit de controle 
		 - double invariance des bits d'input 

		 Attention a enlever des voisins le parent ignore
		 Le cas invariance d'un des 2 bits d'input n'est pas interressante

		 DontCare : 
		 - Si sur le controle et si un des deux inputs est invariant -> invariant
		 - S'il y a un DontCare sur une des input -> id ou invariant
		 - S'il y a un DontCare sur les 2 input -> DontCare
		 - DontCare Controle + DontCare une input -> DontCare
		 
	      *) 
	      
	      (* Il peut y avoir application partielle a gauche ou a droite *)
	      match cds_tag.(i).entrees_taguee.(0), cds_tag.(i).entrees_taguee.(1), cds_tag.(i).entrees_taguee.(2) with
	      | Invariante, input1, input2 ->
		  begin
		    (* On regarde d'abord statiquement vers qui on s'oriente *)
		    let input_stat, index_input, autre_index = if cds_tag.(i).infos_node.entree.(0) then input1, 1, 2 else input2, 2, 1 in
		    begin
		      (* il ne faut pas oublier d'enlever le lien vers cette porte chez les l'autre parent eventuel *)
		      (
			match cds_tag.(i).entrees_taguee.(autre_index) with
			| Pointee (av, aindex) -> 
			    begin
			      let filter (a, b) = (a <> i) in
			      let removed_this = List.filter filter cds_tag.(av).infos_node.voisins.(aindex) in
			      cds_tag.(av).infos_node.voisins.(aindex) <- removed_this 
			    end
			| Invariante | DontCare -> ()
		      );
		      match input_stat with
		      | Pointee (v, index) -> 
			  begin
			    remove_as_id (v, index) i;
			  end
		      | Invariante ->
			  (* La porte mux est changee soit en Vdd, soit en Gnd, donc aussi supprimee *)
			  let value = cds_tag.(i).infos_node.entree.(index_input) in
			  remove_as_cst_value ~value:value i
		      | DontCare -> remove_as_dontcare i
		    end
		  end  
	      | Pointee (v, index), Invariante, Invariante -> 
		  begin
		    (* Il y a 4 cas, 11 00 10 01, avec des consequences distinctes : *)
		    match cds_tag.(i).infos_node.entree.(1), cds_tag.(i).infos_node.entree.(2) with
		    | false, false -> (* GND *) remove_as_cst_value ~pointage:(v, index) ~value:false i
		    | true, false -> (* ID  du controle *) remove_as_id (v, index) i
		    | false, true -> (* Not du controle *) changing_into_not (v, index) i
		    | true, true -> (* VDD *) remove_as_cst_value ~pointage:(v, index) ~value:true i
		  end
		    
	      | DontCare, Pointee (v, index), DontCare | DontCare, DontCare, Pointee (v, index) -> 
		  remove_as_dontcare ~pointage:(v, index) i

	      | DontCare, Invariante, DontCare | DontCare, DontCare, Invariante -> remove_as_dontcare i

	      | DontCare, Pointee _, Pointee _ -> garder_noeud i
    
	      | DontCare, Invariante, Pointee (v, index) ->
		  begin
		    let value = cds_tag.(i).infos_node.entree.(1) in
		    remove_as_cst_value ~pointage:(v, index) ~value:value i
		  end
	      | DontCare, Pointee (v, index), Invariante -> 
		  begin
		    let value = cds_tag.(i).infos_node.entree.(2) in
		    remove_as_cst_value ~pointage:(v, index) ~value:value i
		  end
	      | Pointee (v, index), DontCare, DontCare -> remove_as_dontcare ~pointage:(v, index) i
		  
	      | _, DontCare, DontCare -> remove_as_dontcare i
	      (* 14 cas *)
	      | Pointee _, Pointee _, _ | Pointee _, _, Pointee _ -> garder_noeud i

	      | Pointee (v, index), DontCare, Invariante ->
		  begin
		    (* Le DontCare prend la meme valeur que l'invariant *)
		    let value = cds_tag.(i).infos_node.entree.(2) in
		    remove_as_cst_value ~pointage:(v, index) ~value:value i
		  end
	      | Pointee (v, index), Invariante, DontCare ->
		  begin
		    (* Le DontCare prend la meme valeur que l'invariant *)
		    let value = cds_tag.(i).infos_node.entree.(1) in
		    remove_as_cst_value ~pointage:(v, index) ~value:value i
		  end

	      | DontCare, Invariante, Invariante ->
		  begin
		    (* On peut etre tres sioux dans ce cas :
		       Si les entrees sont differentes, on peut propager le dontcare, il suffit de choisir la bonne valeur *)
		    (* Si les entrees sont les memes, on a pas le choix, c'est du constant *)
		    
		    match cds_tag.(i).infos_node.entree.(1), cds_tag.(i).infos_node.entree.(2) with
		    | false, false -> (* GND *) remove_as_cst_value ~value:false i
		    | true, true -> (* VDD *) remove_as_cst_value ~value:true i
		    | _ -> (* DONTCARE *) remove_as_dontcare i
		  end
	    end 
	      
	      
	| PipeNode _ | ExternalNode _ ->
	    begin
	      (* TODO : warning all invariant pour pipe et external *)
	      use_node i;
	      garder_noeud i
	    end
	      
	(* Optimisation de registres : avec declanchement de reinspection dans les cas optimises *)
	(* On rappelle que l'enable est la composante 1 du Regr *)    
	| Regr regt ->
	    (* Quand on garde un registre receiver, on met un lien chez le transmitteur pour 
	       permettre dans l'etape suivante d'aller dans les deux sens Regr <--> Regt *)
	    cds_tag.(regt).entrees_taguee <- [|Pointee (i, 0)|];
	    let reg_garder_noeud () = () in
	    let value = cds_tag.(regt).infos_node.sortie.(0) in 
	    let enable = cds_tag.(i).infos_node.entree.(1) in
	    begin
	      match cds_tag.(i).entrees_taguee.(0), cds_tag.(i).entrees_taguee.(1) with
	      | Pointee _, Pointee _ -> reg_garder_noeud () 
	      | Invariante, Pointee (v, index) ->
		  (* L'enable est pointe, et l'entree invariante. Il faut verifier si la valeur
		     initiale du Regt est egale a la valeur d'entree du Regr dans ce cas on peut 
		     enlever, sinon, on garde *)
		  if value = cds_tag.(i).infos_node.entree.(0)
		  then remove_reg_as_cst_value ~regt:regt ~pointage:(v, index) ~value:value i
		  else reg_garder_noeud () 
		    
	      | Pointee (v, index), Invariante ->
		  (* L'enable est invariant. S'il est a false alors le Regt se transorme en noeud constant vdd ou gnd *)
		  if not(enable)
		  then remove_reg_as_cst_value ~regt:regt ~pointage:(v, index) ~value:value i
		  else reg_garder_noeud ()
		  
	      | Invariante, Invariante ->
		  (* C'est un melange des 2 cas ci dessus *)
		  if not(enable)
		  then remove_reg_as_cst_value ~regt:regt ~value:value i
		  else
		    (* Seulement si la valeur initiale est la meme *)
		    if value = cds_tag.(i).infos_node.entree.(0)
		    then remove_reg_as_cst_value ~regt:regt ~value:value i
		    else reg_garder_noeud () 
	    
	      | DontCare, Pointee (v, index) ->
		  (* On peut le rendre constant mais pas dontcare *)
		  remove_reg_as_cst_value ~regt:regt ~pointage:(v, index) ~value:value i

	      | DontCare, Invariante -> remove_reg_as_cst_value ~regt:regt ~value:value i 

	      | Pointee (v, index), DontCare -> remove_reg_as_cst_value ~regt:regt ~pointage:(v, index) ~value:value i
		  (* on passe l'enable a false, on devient constant *)

	      | Invariante, DontCare -> remove_reg_as_cst_value ~regt:regt ~value:value i

	      | DontCare, DontCare -> remove_reg_as_cst_value ~regt:regt ~value:value i
	    end
	      
	| Regt -> garder_noeud i
	      
	(* Input, Output : pas d'optimisation, pas de warning *)
	      
	| Input | Output -> use_node i; garder_noeud i 
	| Reg | NReg -> failwith "Registre type confusion a cette etape, optimiseCds"
      end
  in  
  for i = 0 to pred len do
    inspection i
  done;
  (* Maintenant il faut vider la file de reinspection *)
  while not (Queue.is_empty to_reinspecte) do 
    inspection (Queue.pop to_reinspecte)
  done;
  finish (), get_used_nodes ();;
  

(* Une fois le premier parcours termine, toute l'invariance potentielle est suprimee.
   On va faire une deuxieme optimisation qui consiste a observer les noeuds inutiles : 
   c'est ceux qui n'ont pas de voisins. 
   Ces noeuds sont aussi suprimés, en declanchant recursivement les parents 
   qui peuvent devenir aussi inutiles *)

(* La nature du parcours est la meme, file et planning, avec parcours total initial *)

let remove_unused_nodes ?(verbose=false) used_nodes cds_tag =
  let to_reinspecte = Queue.create () in
  let len = Array.length cds_tag in
  let planning_inspection = Array.make len true in (* Au debut, tout le monde est prevu au planning *)
  let reinspecte_node i = 
    (* Tout depend du planning *)
    if planning_inspection.(i) 
    then () (* On a deja prevu d'inspecter ce noeud, inutile de le mettre en file *)
    else  
      begin (* Ok, dans ce cas, on l'ajoute au planning *)
	planning_inspection.(i) <- true;
	Queue.add i to_reinspecte
      end 
  in
  let finish () = cds_tag in
  (* Il faut tout d'abord taguer recursivement tous les noeuds utiles, en remontant les parents *)
  (* Pour cela, on utilise la file used_nodes *)
  let tag_use_node i =
    if cds_tag.(i).used then ()  
    else
      begin
	(* prerr_endline (Printf.sprintf "tag use %d" i); *)
	cds_tag.(i).used <- true;
	(* Les parents *)
	let iter_entree_taguee = function
	  | DontCare -> ()
	  | Invariante -> ()
	  | Pointee (v, _) -> Queue.add v used_nodes (* d'ou l'interet d'avoir tague tous les registres regt *)
	in
	Array.iter iter_entree_taguee cds_tag.(i).entrees_taguee
      end 
  in
  (* La fonction qui gere la suppression d'un noeud, en faisant les mise a jour pointeurs *)
  (* Un noeud est enleve s'il n'a pas de voisin. On doit donc simplement retirer les 
     liens des cases voisins des parents de ce noeud. Comme les parents sont modifies,
     il faut les remettre dans la file, pour re-inspection *)
  let remove_node ?(regt=false) i = 
    (* Dans le cas d'un registre, on appelle 2 fois la fonction *)
    (* On ne doit pas chercher a supprimer le lien chez le regr qui n'a pas de voisins par construction *)
    let iter_entree_taguee = function
      | DontCare -> ()
      | Invariante -> () 
      | Pointee (v, index) ->
	  begin
	    (* suppression du lien vers cette porte qui disparait *)
	    let filter (a, b) = (a <> i)  in
	    let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
	    cds_tag.(v).infos_node.voisins.(index) <- removed_this;
	    (* reinspection du noeud parent qui peut avoir perdu tous ses descendants et devenir inutile *)
	    reinspecte_node v;
	  end 
    in
    cds_tag.(i).delete <- true;
    (* Dans le cas de memoires, il faut mettre un message *)
    (
      match cds_tag.(i).infos_node.noeud_type with
      | Rom (name, _) | Ram (name, _) -> Message.message#unused_all_output_memory name
      | _ -> ()
    );
    if not regt then Array.iter iter_entree_taguee cds_tag.(i).entrees_taguee
    else ()
  in
  (* La fonction de parcours qui decide du caractere inutile d'un noeud *)
  let inspection i =
    (* prerr_endline (Printf.sprintf "inspecte node %d" i); *)

    planning_inspection.(i) <- false; (* on peut le remettre en file desormais *) 
    (* Si ce noeud a deja fait l'objet d'une demande de suppression, il n'y a rien a faire *)
    if cds_tag.(i).delete then ()
    else
      (* Si ce noeud n'est pas utilise, on l'enleve *)
      if not cds_tag.(i).used 
      then 
	match cds_tag.(i).infos_node.noeud_type with
	| Regt -> remove_node ~regt:true i
	| _ -> remove_node i
      else
	
	match cds_tag.(i).infos_node.noeud_type with
	
	(* On en profite pour faire une verification de ce qu'il peut rester comme type de noeud *)
	| Id | Clock | Gnd | Vdd | Opt | Reg | NReg -> failwith "Residu noeud type innatendu in optimiseCds.ml"
	    
	(* Ensuite : pour les portes classiques, c'est le meme traitement *) 
	| Not | Et | Ou | Xor | Mux ->
	    begin (* il n'y a qu'une sortie *)
	      match cds_tag.(i).infos_node.voisins.(0) with
		(* Si personne n'utilise le resultat de ce noeud : on l'enleve *) 
	      | [] -> remove_node i
	      | _ -> ()
	  end
	      
	(* Pour les registres, la gestion de la suppression est un plus compliquee *)
	| Regr _ -> () (* Par representation, ce type de noeud n'a jamais de fils explicite *)
	| Regt -> 
	    begin (* il n'y a qu'une sortie *)
	      match cds_tag.(i).infos_node.voisins.(0) with
		(* Si personne n'utilise le resulate de ce noeud : on l'enleve *)
		(* Dans le parcours precedent, on a ajoute un pointeur vers le Regr correspondant *)
	      | [] ->
		  begin
		    let regr = 
		      if Array.length cds_tag.(i).entrees_taguee < 1 
		      then failwith "entree taguee pointeur regr parcours precedent"
		      else
			match cds_tag.(i).entrees_taguee.(0) with
			| Pointee (v, _) -> v
			| Invariante -> failwith "Invariance pointeur regr optimiseCds"
			| DontCare -> failwith "DontCare pointeur regr optimiseCds"
		    in
		    (* Petite verification qui coute pas cher *)
		    (
		      match cds_tag.(regr).infos_node.noeud_type with
		      | Regr j when i = j -> ()
		      | _ -> failwith "Incoherence pointage registre dans optimiseCds"
		    );
		    (* On enleve le noeud Regt et Regr *)
		    remove_node ~regt:true i; (* ne pas chercher a aller voir les parents *)
		    remove_node regr
		  end
	      | _ -> () 
	    end
	      
	| Ram (name, _) | Rom (name, _) ->
	    begin
	      (* Si toutes les sorties sont inutiles, on warning, et on enleve carrement le noeud *)
	      (* Si une au moins on message design, mais on garde *)
	      let size = Array.length cds_tag.(i).infos_node.voisins in
	      let all_unused = ref true in
	      let unused_outputs = 
		let rec aux accu j =
		  if j < 0 then accu
		  else 
		    match cds_tag.(i).infos_node.voisins.(j) with
		    | [] -> aux (j::accu) (pred j)
		    | _ -> all_unused := false; aux accu (pred j)
		in aux [] (pred size) 
	      in
	      if !all_unused 
	      then remove_node i
	      else
		match unused_outputs with
		| [] -> ()
		| _ -> Message.message#unused_some_output_memory name (string_of_list string_of_int ", " "(" ")" unused_outputs)
	    end 
	      
	| Input | Output ->  () 
	    
	| ExternalNode _ | PipeNode _ -> () (* TODO : des messages warning *) 
  in
  (* Avant toute chose, on decide de l'use des noeuds parents des output, external, et pipe *)
  while not(Queue.is_empty used_nodes) do
    tag_use_node (Queue.pop used_nodes)
  done;
  (* Ensuite, on peut proceder a l'inspection *)
  for i = 0 to pred len do 
    inspection i
  done;
  while not (Queue.is_empty to_reinspecte) do
    inspection (Queue.pop to_reinspecte)
  done;
  finish ();;

(* Le travail suivant consiste a reconstruire un cds en enlevant les noeuds qui doivent l'etre, 
   et en mettant a jour les liens qui changent vu qu'on enleve des noeuds dans le tableau. *) 
let rebuild_cds_of_optimised_cds ?(verbose=false) ocds =
  let len = Array.length ocds in
  let maping = Array.make len None in
  let noeuds = Queue.create () in
  let index = ref 0 in
  for i = 0 to pred len do
    if ocds.(i).delete 
    then maping.(i) <- None
    else 
      begin
	Queue.add ocds.(i).infos_node noeuds;
	maping.(i) <- Some (!index);
	incr(index)
      end
  done;
  (* On dispose maintenant de la fonction de maping et des noeuds a conserver *)
  let map_voisin (v, index) =
    (* On fait en meme temps les verifications qu'un lien n'est pas vers un supprime *)
    match maping.(v) with 
    | None -> failwith (Printf.sprintf "Optimise : un noeud pointe vers un supprime : %d" v)
    | Some i -> (i, index)
  in
  let init_node _ =
    let node = Queue.pop noeuds in
    let new_node = match node.noeud_type with
    | Regr v -> 
	begin
	  match maping.(v) with
	  | None -> failwith (Printf.sprintf "Regr rebuild : pointe sur removed : %d" v)
	  | Some v2 -> Regr v2
	end
    | _ -> node.noeud_type
    in
    {
      entree = node.entree;
      sortie = node.sortie;
      noeud_type = new_node;
      voisins = Array.map (fun a -> List.map map_voisin a) node.voisins
    }
  in
  Array.init (Queue.length noeuds) init_node 
;;
  

(* Pretty printer : Sinon, on voit rien *)
(* TODO : mettre dans BopPrinter *)
module PPrinter =
struct
  let of_node_type = function
    | Input -> "Input"
    | Output -> "Output"
    | Opt -> "Opt"
    | Id -> "Id"
    | Not -> "Not"
    | Et -> "And"
    | Ou -> "Or"
    | Xor -> "Xor"
    | Mux -> "Mux"
    | Rom (n, i) -> Printf.sprintf "Rom(%s)" n
    | Ram (n, _) -> Printf.sprintf "Ram(%s)" n
    | Reg | NReg -> "REGNonSplit"
    | Regr i -> Printf.sprintf "Regr(%d)" i 
    | Regt -> "Regt"
    | Clock -> "Clock" 
    | Gnd -> "Gnd"
    | Vdd -> "Vdd"
    | PipeNode (s, _, _) -> Printf.sprintf "pipe(%s)" s
    | ExternalNode (_, _, n, None, _,  _, _) -> Printf.sprintf "$%s" n
    | ExternalNode (_, _, n, Some m, _,  _, _) -> Printf.sprintf "$%s.%s" n !m

  let of_voisins vs =
    let link (v, index) = Printf.sprintf "%d[%d]" v index in 
    let fold (accu, i) v =
      (Printf.sprintf "%s[%d : %s] " accu i (string_of_list link ", " "(" ")" v)), succ i  
    in 
    let res, _ = Array.fold_left fold ("", 0) vs in 
    res

  let of_node i node = 
    let fleche a = if Array.length a > 0 then "->" else "" in
    let voisins = of_voisins node.voisins in
    Printf.sprintf "%5d : %s %s %s %s %s   %s" i (BoolArray.to_string node.entree) (fleche node.entree)
      (of_node_type node.noeud_type) (fleche node.sortie) (BoolArray.to_string node.sortie) voisins
 

  let of_tag_node i nodetag =
    let node = nodetag.infos_node in
    let voisins = of_voisins node.voisins in
    let fleche a = if Array.length a > 0 then "->" else "" in
    let line1 = 
      Printf.sprintf "%5d %s %s : %s %s %s %s %s\n" i 
	(if nodetag.delete then "DELETE" else "")
	(if nodetag.used then "USED" else "UNUSED")
	(BoolArray.to_string node.entree) (fleche node.entree) 
	(of_node_type node.noeud_type) (fleche node.sortie) (BoolArray.to_string node.sortie)
    in
    let inputs = 
      if node.noeud_type = Regt 
      then 
	match nodetag.entrees_taguee.(0) with
	| Pointee (v, _) -> Printf.sprintf "<- reg %d" v
	| _ -> "Pas de pointeur"
      else
	let fold (accu, i) _ = match nodetag.entrees_taguee.(i) with 
	| DontCare -> (Printf.sprintf "%s *" accu), (succ i)
	| Invariante -> (Printf.sprintf "%s !%c" accu (char_of_bool node.entree.(i))), (succ i)  
	| Pointee (v, index) -> (Printf.sprintf "%s (%d[%d]).%c" accu v index (char_of_bool node.entree.(i))), (succ i)  
      in 
      let res, _ = Array.fold_left fold ("", 0) node.entree in res
    in
    let line2 = Printf.sprintf "Inputs  : %s\nOutputs : %s" inputs voisins in
    line1^line2

  let fct__ fct = fun t -> (fct t; fct "--------")

  let print_cds fct cds = 
    let f_iteri i n = (fct__ fct) (of_node i n) in
    Array.iteri f_iteri cds
      
  let print_cds_tag fct cds =
    let f_iteri i n = (fct__ fct) (of_tag_node i n) in
    Array.iteri f_iteri cds     
end;;

(* Statistiques pour l'optimisation *)
let statistique cds step1 step2 final = 
  
  print_endline "OPTIMISATION CDS :";
  print_endline "CDS non optimise :";
  PPrinter.print_cds print_endline cds;
  print_endline "\nCDS Step 1 : remove invariance";
  PPrinter.print_cds_tag print_endline step1;
  print_endline "\nCDS Step 2 : remove unused";
  PPrinter.print_cds_tag print_endline step2;
  print_endline "\nCDS FINAL : reconstruction";
  PPrinter.print_cds print_endline final
 

(* Recapitulatif des optimisations *)

let optimise cds =
  let verbose = Message.message#get_verbose in
  if verbose
  then
    begin
      print_endline "OPTIMISATION CDS :";
      print_endline "CDS non optimise :";
      PPrinter.print_cds print_endline cds;

      print_endline "\nStep 1 : Remove invariance";
      let step1, used_nodes = remove_invariance_of_cds ~verbose:true cds in
      PPrinter.print_cds_tag print_endline step1;

      print_endline "\nStep 2 : remove unused";
      let step2 = remove_unused_nodes ~verbose:true used_nodes step1 in
      PPrinter.print_cds_tag print_endline step2;

      print_endline "\nFINAL : reconstruction";
      let optim = rebuild_cds_of_optimised_cds ~verbose:true step2 in
      PPrinter.print_cds print_endline optim;
      optim
    end
  else 
    let cds_step1, used = remove_invariance_of_cds cds in
    let cds_step2 = remove_unused_nodes used cds_step1 in
    let cds_optim = rebuild_cds_of_optimised_cds cds_step2 in
    cds_optim;;
(* FIXME : cds_optim;; *)
